home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbpxen / vvdbmod2.bas < prev    next >
BASIC Source File  |  1991-10-07  |  6KB  |  173 lines
  1. '
  2. '   Written by Steve Jackson
  3. '              9152 Brabham Dr.
  4. '              Huntington Beach, CA 92646
  5. '
  6. '   This is meant to be called from your form objects.  In turn, these
  7. '   functions call routines in PXMODULE.BAS that access Paradox.  I 
  8. '   tried to isolate all Paradox specific code there in case you want
  9. '   to change your app to some other DBMS later (SQL Server, xbase, etc.)
  10. '   or it you don't like it and want to change it...
  11. '
  12. Function GetItemRec (ByVal Action%) As Integer
  13.     '
  14.     '   Get the item record and move all fields to
  15.     '   a record buffer that is global
  16.     '
  17.     If Action% = DBKEYED Then
  18.         rc = PutAlphaField(ITEM_TABLE, 1, itemrec.itemnumber)
  19.     End If
  20.  
  21.     rc = GetRec(ITEM_TABLE, Action%)
  22.     '
  23.     '  Assume the error handling function traps fatal errors and
  24.     '  ends the program.  Here we assume any error is of the expected
  25.     '  variety, such as not-found, end-of-file, duplicate-key, etc.
  26.     '
  27.     If rc = DB_NOTFOUND Then
  28.         GetItemRec = rc
  29.         Beep
  30.         Msg$ = "Item not found for this item number"
  31.         MsgBox Msg$, MB_ICONINFORMATION, "Get Item"
  32.         Exit Function
  33.     End If
  34.     '
  35.     '  Assume that if there is still an error, it is at end or
  36.     '  start of file.  Just beep, but do not display any msg
  37.     '
  38.     If rc Then
  39.         GetItemRec = rc
  40.         Beep
  41.         Exit Function
  42.     End If
  43.     '
  44.     '  Move fields from paradox to the record buffer
  45.     '  The fields are NOT on the form at this point
  46.     '
  47.     rc = GetAlphaField(ITEM_TABLE, 1, itemrec.itemnumber)
  48.     rc = GetAlphaField(ITEM_TABLE, 2, itemrec.itemdesc)
  49.     rc = GetAlphaField(ITEM_TABLE, 3, itemrec.custnum)
  50.     rc = GetAlphaField(ITEM_TABLE, 5, itemrec.inout_code)
  51.     '
  52.      GetItemRec = DB_OK
  53. End Function
  54.  
  55. Function UpdateItemRec () As Integer
  56.     '
  57.     '  Write the current record back to the database.
  58.     '  Assume no-one else has changed the positioning since
  59.     '  the time we got the record, and when the update takes place.
  60.     '  Note:  this may be a dangerous assumption in Windows...
  61.     '
  62.     rc = PutAlphaField(ITEM_TABLE, 1, itemrec.itemnumber)
  63.     rc = PutAlphaField(ITEM_TABLE, 2, itemrec.itemdesc)
  64.     rc = PutAlphaField(ITEM_TABLE, 3, itemrec.custnum)
  65.     rc = PutAlphaField(ITEM_TABLE, 5, itemrec.inout_code)
  66.     
  67.     rc = UpdateRec(ITEM_TABLE)
  68.     UpdateItemRec = rc
  69.  
  70.     If rc Then
  71.         Beep
  72.         Msg$ = "Update failed, reason code: " + Str$(rc)
  73.         MsgBox Msg$, MB_ICONEXCLAMATION, "Update Item"
  74.     End If
  75.  
  76.     rc = UnlockRec(ITEM_TABLE)
  77. End Function
  78.  
  79. Function AddItemRec () As Integer
  80.     '
  81.     '  Write the record to the database.
  82.     '  Assume no-one else has already added one with this key.
  83.     '  Note:  this may be a dangerous assumption in Windows...
  84.     '
  85.     rc = PutAlphaField(ITEM_TABLE, 1, itemrec.itemnumber)
  86.     rc = PutAlphaField(ITEM_TABLE, 2, itemrec.itemdesc)
  87.     rc = PutAlphaField(ITEM_TABLE, 3, itemrec.custnum)
  88.     rc = PutAlphaField(ITEM_TABLE, 5, itemrec.inout_code)
  89.  
  90.     rc = AddRec(ITEM_TABLE)
  91.     AddItemRec = rc
  92.     '
  93.     '  assume serious errors were trapped in pxerror()
  94.     '  if the add fails, assume it is a duplicate key
  95.     '
  96.     If rc Then
  97.         Beep
  98.         Msg$ = "ADD failed - there is already a item with this number"
  99.         MsgBox Msg$, MB_ICONINFORMATION, "Add Item"
  100.     End If
  101.  
  102.     AddItemRec = rc
  103. End Function
  104.  
  105. Function DeleteItemRec () As Integer
  106.     '
  107.     '  Write the current record back to the database.
  108.     '  Assume no-one else has changed the positioning since
  109.     '  the time we got the record, and when the update takes place.
  110.     '  Note:  this may be a dangerous assumption in Windows...
  111.     '
  112.     '  Just move the key field to the record buffer
  113.     '
  114.     rc = PutAlphaField(ITEM_TABLE, 1, itemrec.itemnumber)
  115.  
  116.     rc = DeleteRec(ITEM_TABLE)
  117.     '
  118.     '  assume serious errors were trapped in pxerror()
  119.     '  if the delete fails, assume it was already deleted
  120.     '
  121.     If rc Then
  122.         Beep
  123.         Msg$ = "DELETE failed - Item was already deleted"
  124.         MsgBox Msg$, MB_ICONEXLAMATION, "Delete Item"
  125.     End If
  126.  
  127.     DeleteItemRec = rc
  128. End Function
  129.  
  130. Function GetItemRecForUpdate () As Integer
  131.     '
  132.     '   Get the item record by key value,
  133.     '   and place a record lock on it.
  134.     '
  135.     '   Move all fields to a record buffer that is global
  136.     '
  137.     rc = PutAlphaField(ITEM_TABLE, 1, itemrec.itemnumber)
  138.     
  139.     rc = GetRec(ITEM_TABLE, DB_KEYED)
  140.     '
  141.     '  Assume the error handling function traps fatal errors and
  142.     '  ends the program.  Here we assume any error is of the expected
  143.     '  variety, such as not-found, end-of-file, duplicate-key, etc.
  144.     '
  145.     If rc Then
  146.         GetItemRecForUpdate = rc
  147.         Beep
  148.         Msg$ = "Item record was not found for this item number"
  149.         MsgBox Msg$, MB_ICONINFORMATION, "Get Item"
  150.         Exit Function
  151.     End If
  152.     '
  153.     '  Place the lock,
  154.     '    if it fails, try again until user quits
  155.     '
  156.     rc = LockRec(ITEM_TABLE)
  157.     If rc Then
  158.         GetItemRecForUpdate = rc
  159.         Msg$ = "Item record is locked by someone else"
  160.         MsgBox Msg$, MB_ICONINFORMATION, "Get Item"
  161.         Exit Function
  162.     End If
  163.  
  164.  
  165.     rc = GetAlphaField(ITEM_TABLE, 1, itemrec.itemnumber)
  166.     rc = GetAlphaField(ITEM_TABLE, 2, itemrec.itemdesc)
  167.     rc = GetAlphaField(ITEM_TABLE, 3, itemrec.custnum)
  168.     rc = GetAlphaField(ITEM_TABLE, 5, itemrec.inout_code)
  169.  
  170.     GetItemRecForUpdate = DB_OK
  171. End Function
  172.  
  173.